home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbwinfnt.zip / EX_WIDTH.BAS < prev    next >
BASIC Source File  |  1994-03-01  |  6KB  |  166 lines
  1.       REM:  EX_WIDTH.BAS, Unregistered Version 1.0
  2.       REM:  Example of using WidthString to break a line.
  3.  
  4.       DECLARE FUNCTION WidthString% (Text$, FontArray%())
  5.  
  6.       DECLARE SUB BLOADFont (FlName$, FontArray%(), RetCode%)
  7.       DECLARE SUB FastString (Text$, FClr%, X%, Y%, FontArray%())
  8.      
  9.       '...setup a VGA screen mode...
  10.       SCREEN 12
  11.      
  12.       '...dimension array for font data (use REDIM so they're DYNAMIC)...
  13.       REDIM FontArray%(1)
  14.     
  15.       '...load in a fonts and check the return code...
  16.       CALL BLOADFont("DTCH_BLD.BIN", FontArray%(), RetCode%)
  17.       IF (RetCode% <> 0) THEN STOP
  18.      
  19.       '...define x-limits in which to display, y start, and text color...
  20.       XMin% = 100: XMax% = 300: YRow% = 100: FClr% = 7
  21.  
  22.       Text$ = "This is a simple demonstration of breaking text between "
  23.       Text$ = Text$ + "words to fit on a line."
  24.  
  25.       '...compute line width...
  26.       BxWidth% = XMax% - XMin% + 1
  27.     
  28.       '...start at the first char and a min x-coord...
  29.       i% = 1: X% = XMin%
  30.    
  31.       '...set row spacing - vertical spacing + any vertical padding...
  32.       DRow% = FontArray%(7) + FontArray%(10)
  33.    
  34.       DO
  35.    
  36.         '...find the next word break (the next space)...
  37.         j% = INSTR(i%, Text$, " ")
  38.  
  39.         '...if no space found before the end, skip to the end...
  40.         IF (j% <= 0) THEN j% = LEN(Text$)
  41.      
  42.         '...pull the word...
  43.         Word$ = MID$(Text$, i%, j% - i% + 1)
  44.  
  45.         '...compute its width...
  46.         WordWidth% = WidthString%(Word$, FontArray%())
  47.  
  48.         '...will this word exceed the length of the box or end of text...
  49.         IF (CurrLine% + WordWidth% > BxWidth%) THEN
  50.          
  51.           '...display the text for the line...
  52.           CALL FastString(LineText$, FClr%, X%, YRow%, FontArray%())
  53.  
  54.           '...set to rwo start and add line spacing to next row...
  55.           X% = XMin%: YRow% = YRow% + DRow%
  56.          
  57.           '...the word we just found starts the new line...
  58.           LineText$ = Word$: CurrLine% = WordWidth%
  59.        
  60.         ELSE
  61.          
  62.           '...just add the text to the line and the width counter...
  63.           LineText$ = LineText$ + Word$: CurrLine% = CurrLine% + WordWidth%
  64.  
  65.         END IF
  66.  
  67.         '...if we reached end of string, display any remaining text...
  68.         IF (j% >= LEN(Text$)) THEN
  69.           CALL FastString(LineText$, FClr%, X%, YRow%, FontArray%())
  70.         END IF
  71.  
  72.         '...set i% to the start of the next word...
  73.         i% = j% + 1
  74.      
  75.       LOOP UNTIL (i% > LEN(Text$))
  76.  
  77.       END
  78.  
  79. '     ************************************************************************
  80.       SUB BoxText (Text$, X%, Y%, FClr%, FontArray%())
  81. '     ************************************************************************
  82.   
  83. '     ------------------------------------------------------------------------
  84. '     This is a very simple routine to break text at words to fit in the box
  85. '     defined by (XMin%,YMin%)-(XMax%,YMax%).  The box must be defined in the
  86. '     main module to be shared.
  87. '
  88. '     The routine returns the X%, Y% values updated to the coordinates of the
  89. '     start of the next character.  This allows successive strings to be
  90. '     displayed in the box.
  91. '
  92. '     This is a simple demo routine.  If a word is longer than the box, the
  93. '     entire word is displayed anyway.  No checking is performed for going
  94. '     out the bottom of the box.  Multiple spaces at the end of a line may
  95. '     be carried over to the next line, instead of dropped.  Only the upper
  96. '     edges of the characters are aligned, not the baselines. This means
  97. '     lines with different size fonts will be a mess.
  98. '     ------------------------------------------------------------------------
  99.  
  100.       SHARED XMin%, YMin%, XMax%, YMax%
  101.  
  102.       '...compute box width...
  103.       BxWidth% = XMax% - XMin% + 1
  104.      
  105.       '...start at the first char...
  106.       i% = 1
  107.     
  108.       '...start at the supplied x and y-coordx...
  109.       CurrLine% = X% - XMin%: YRow% = Y%
  110.     
  111.       '...set row spacing - vertical spacing + any vertical padding...
  112.       DRow% = FontArray%(7) + FontArray%(10)
  113.     
  114.       DO
  115.     
  116.         '...find the next word break (the next space)...
  117.         j% = INSTR(i%, Text$, " ")
  118.  
  119.         '...if no space found before the end, skip to the end...
  120.         IF (j% <= 0) THEN j% = LEN(Text$)
  121.       
  122.         '...pull the word and compute its width...
  123.         Word$ = MID$(Text$, i%, j% - i% + 1)
  124.         WordWidth% = WidthString%(Word$, FontArray%())
  125.  
  126.         '...see if this word fits...
  127.         CurrLine% = CurrLine% + WordWidth%
  128.  
  129.         '...has the line exceeded the length of the box or end of text...
  130.         IF (CurrLine% >= BxWidth%) THEN
  131.           
  132.           '...display the text for the line...
  133.           CALL FastString(LineText$, FClr%, X%, YRow%, FontArray%())
  134.  
  135.           '...set to rwo start and add line spacing to next row...
  136.           X% = XMin%: YRow% = YRow% + DRow%
  137.           
  138.           '...the word we just found starts the new line...
  139.           LineText$ = Word$
  140.  
  141.           '...and it's width is the length of the new line...
  142.           CurrLine% = WordWidth%
  143.         
  144.         ELSE
  145.           
  146.           '...just add the text to the line...
  147.           LineText$ = LineText$ + Word$
  148.        
  149.         END IF
  150.  
  151.         '...if we reached end of string, display any remaining text...
  152.         IF (j% >= LEN(Text$)) THEN
  153.           CALL FastString(LineText$, FClr%, X%, YRow%, FontArray%())
  154.         END IF
  155.  
  156.         '...set i% to the start of the next word...
  157.         i% = j% + 1
  158.       
  159.       LOOP UNTIL (i% > LEN(Text$))
  160.  
  161.       '...leave X%, Y% pointing to the start of the next word...
  162.       X% = XMin% + CurrLine% + 1: Y% = YRow%
  163.      
  164.       END SUB
  165.  
  166.